library(tidyverse)
library(ggdist)
library(ggside)
library(easystats)
library(patchwork)
illusion1 <- read.csv("../data/raw_illusion1.csv") |>
mutate(
Illusion_Effect = fct_relevel(as.factor(Illusion_Effect), "Incongruent", "Congruent"),
Block = as.factor(Block)
)
illusion2 <- read.csv("../data/raw_illusion2.csv") |>
mutate(
Illusion_Effect = fct_relevel(as.factor(Illusion_Effect), "Incongruent", "Congruent"),
Block = as.factor(Block)
)
perceptual <- read.csv("../data/raw_perceptual.csv") |>
mutate(
Block = as.factor(Block)
)
sub <- read.csv("../data/raw_questionnaires.csv") |>
mutate(
Education = fct_relevel(Education,
# "Prefer not to Say",
"High school", "Bachelor", "Master", "Doctorate", "Other")
)
# For prolific:
# bayestestR::point_estimate(sub$Duration_Session1)
# plot(bayestestR::estimate_density(sub$Duration_Session1))
# Dear participant, thank you for participating in our study. Unfortunately, our system detected multiple issues in your data (such as implausibly short responses - in particular in the 2nd part of the study, random-like pattern of answers, or the same response to different scales - as some were designed to trigger various answers), which makes it unusable. We understand that you might have been in a hurry or had some other issues, and so we kindly ask you to return your participation; we hope to open-up more slots in the future would you be interested to participate again.
# Dear participant, thank you for participating in our study. Unfortunately, our system detected multiple issues in your data (such as implausibly short responses - in particular in the 2nd part of the study, random-like pattern of answers, or the same response to different scales - as some were designed to trigger various answers), which makes it unusable for us. We understand that you might have been in a hurry or had some other issues; we hope to open-up more slots in the future would you be interested to participate again.
outliers_perceptual <- c(
"S003",
"S008"
)
outliers_illusion1 <- c(
"S008"
)
outliers_illusion2 <- c(
"S003"
)
We removed 1, 2, and 1 participants for the illusion task - session 1, perceptual task, and illusion task - session 2 respectively, upon inspection of the average error rage (when close to 50%, suggesting random answers) and/or when the reaction time distribution was implausibly fast.
data <- rbind(illusion1, illusion2, perceptual) |>
filter(RT < 10) |>
mutate(
Participant = fct_rev(Participant),
Task = fct_relevel(Task, "Illusion_Session1", "Perceptual", "Illusion_Session2")
)
table <- data |>
group_by(Participant, Task) |>
summarize(
Error = sum(Error) / n(),
RT = mean(RT)
) |>
ungroup() |>
arrange(desc(Error)) |>
tidyr::pivot_wider(names_from = "Task", values_from = c("Error", "RT"), names_vary = "slowest") |>
datawizard::data_relocate(ends_with("Session2"), after = -1) |>
arrange(desc(Error_Illusion_Session1))
data.frame(Participant = c("Average"), t(sapply(table[2:ncol(table)], mean, na.rm = TRUE))) |>
rbind(table) |>
knitr::kable() |>
kableExtra::row_spec(1, italic = TRUE, background = "grey", color = "white") |>
kableExtra::row_spec(which(table$Participant %in% c(outliers_perceptual, outliers_illusion1, outliers_illusion2)) + 1, background = "#EF9A9A") |>
# kableExtra::column_spec(2, color="white",
# background = kableExtra::spec_color(c(NA, table$Error_Illusion_Session1))) |>
kableExtra::kable_styling(full_width = TRUE) |>
kableExtra::scroll_box(width = "100%", height = "500px")
| Participant | Error_Perceptual | RT_Perceptual | Error_Illusion_Session1 | RT_Illusion_Session1 | RT_Illusion_Session2 | Error_Illusion_Session2 |
|---|---|---|---|---|---|---|
| Average | 0.068 | 0.678 | 0.182 | 0.766 | 0.731 | 0.265 |
| S008 | 0.500 | 0.347 | 0.417 | 0.610 | ||
| S002 | 0.115 | 0.872 | 0.346 | 0.713 | 0.945 | 0.396 |
| S023 | 0.125 | 0.619 | 0.346 | 0.631 | ||
| S070 | 0.149 | 1.014 | 0.314 | 1.118 | ||
| S080 | 0.120 | 0.532 | 0.286 | 0.477 | ||
| S087 | 0.151 | 0.589 | 0.279 | 0.576 | ||
| S021 | 0.250 | 0.703 | 0.263 | 0.544 | ||
| S059 | 0.021 | 0.488 | 0.260 | 0.542 | ||
| S073 | 0.104 | 0.596 | 0.258 | 0.665 | ||
| S006 | 0.089 | 0.620 | 0.258 | 0.529 | 0.723 | 0.216 |
| S094 | 0.089 | 0.514 | 0.250 | 0.602 | ||
| S053 | 0.151 | 0.475 | 0.245 | 0.511 | ||
| S048 | 0.052 | 0.502 | 0.242 | 0.502 | ||
| S101 | 0.177 | 0.406 | 0.240 | 0.427 | ||
| S025 | 0.073 | 0.598 | 0.237 | 0.713 | ||
| S007 | 0.089 | 0.770 | 0.234 | 0.894 | ||
| S036 | 0.068 | 0.749 | 0.232 | 0.845 | ||
| S083 | 0.042 | 0.561 | 0.229 | 0.588 | ||
| S063 | 0.042 | 0.797 | 0.228 | 0.885 | ||
| S014 | 0.047 | 0.548 | 0.227 | 0.641 | ||
| S097 | 0.068 | 0.528 | 0.224 | 0.791 | ||
| S019 | 0.052 | 0.496 | 0.224 | 0.618 | ||
| S046 | 0.073 | 0.553 | 0.221 | 0.620 | ||
| S042 | 0.161 | 0.493 | 0.221 | 0.560 | ||
| S092 | 0.036 | 0.810 | 0.217 | 1.202 | ||
| S079 | 0.052 | 0.588 | 0.216 | 0.586 | ||
| S003 | 0.214 | 0.441 | 0.211 | 0.853 | 0.331 | 0.371 |
| S064 | 0.073 | 0.714 | 0.211 | 0.885 | ||
| S093 | 0.057 | 0.512 | 0.208 | 0.516 | ||
| S043 | 0.057 | 0.823 | 0.208 | 0.688 | ||
| S086 | 0.099 | 0.717 | 0.206 | 0.726 | ||
| S096 | 0.094 | 0.473 | 0.203 | 0.554 | ||
| S100 | 0.083 | 0.730 | 0.201 | 0.740 | ||
| S066 | 0.031 | 0.728 | 0.201 | 0.859 | ||
| S001 | 0.323 | 0.946 | 0.199 | 0.986 | ||
| S052 | 0.031 | 0.541 | 0.195 | 0.537 | ||
| S085 | 0.177 | 0.637 | 0.193 | 0.824 | ||
| S047 | 0.094 | 0.624 | 0.191 | 0.823 | ||
| S072 | 0.057 | 0.960 | 0.190 | 0.925 | ||
| S082 | 0.125 | 0.410 | 0.188 | 0.470 | ||
| S067 | 0.099 | 0.550 | 0.188 | 0.560 | ||
| S026 | 0.036 | 0.732 | 0.182 | 0.934 | ||
| S017 | 0.068 | 0.534 | 0.180 | 0.606 | ||
| S040 | 0.026 | 0.829 | 0.180 | 0.929 | ||
| S089 | 0.031 | 0.603 | 0.178 | 0.888 | ||
| S044 | 0.016 | 0.642 | 0.177 | 0.665 | ||
| S035 | 0.099 | 0.497 | 0.177 | 0.523 | ||
| S030 | 0.068 | 0.546 | 0.177 | 0.718 | ||
| S013 | 0.062 | 0.563 | 0.177 | 0.706 | ||
| S076 | 0.031 | 0.671 | 0.174 | 0.655 | ||
| S034 | 0.099 | 0.645 | 0.174 | 0.792 | ||
| S022 | 0.078 | 0.500 | 0.174 | 0.601 | ||
| S065 | 0.021 | 0.605 | 0.172 | 0.811 | ||
| S062 | 0.042 | 0.641 | 0.172 | 0.708 | ||
| S038 | 0.115 | 0.618 | 0.167 | 0.691 | ||
| S033 | 0.083 | 0.698 | 0.167 | 0.752 | ||
| S024 | 0.042 | 0.756 | 0.167 | 0.735 | ||
| S020 | 0.073 | 0.833 | 0.167 | 0.820 | ||
| S050 | 0.016 | 0.714 | 0.164 | 1.025 | ||
| S009 | 0.010 | 0.633 | 0.164 | 0.833 | ||
| S054 | 0.057 | 0.535 | 0.161 | 0.576 | ||
| S039 | 0.083 | 0.517 | 0.161 | 0.524 | ||
| S004 | 0.010 | 0.800 | 0.161 | 1.051 | ||
| S011 | 0.042 | 0.657 | 0.159 | 0.755 | 0.687 | 0.185 |
| S071 | 0.016 | 0.836 | 0.159 | 0.748 | ||
| S068 | 0.052 | 0.624 | 0.156 | 1.011 | ||
| S032 | 0.031 | 0.585 | 0.154 | 0.550 | ||
| S088 | 0.026 | 0.878 | 0.148 | 1.056 | ||
| S077 | 0.057 | 1.019 | 0.148 | 0.884 | ||
| S074 | 0.052 | 0.533 | 0.146 | 0.730 | ||
| S058 | 0.036 | 0.596 | 0.146 | 0.609 | ||
| S057 | 0.021 | 0.562 | 0.146 | 0.645 | ||
| S084 | 0.000 | 0.966 | 0.143 | 0.932 | ||
| S045 | 0.010 | 0.912 | 0.141 | 0.730 | ||
| S015 | 0.047 | 0.643 | 0.135 | 0.580 | ||
| S098 | 0.021 | 0.849 | 0.134 | 0.993 | ||
| S095 | 0.021 | 0.931 | 0.133 | 1.531 | ||
| S091 | 0.031 | 0.561 | 0.130 | 0.673 | ||
| S081 | 0.021 | 0.718 | 0.130 | 0.733 | ||
| S075 | 0.068 | 0.890 | 0.130 | 1.089 | ||
| S060 | 0.042 | 0.695 | 0.130 | 0.947 | ||
| S041 | 0.052 | 0.672 | 0.130 | 0.751 | ||
| S051 | 0.016 | 0.569 | 0.128 | 0.753 | ||
| S037 | 0.047 | 0.756 | 0.128 | 0.965 | ||
| S018 | 0.052 | 0.682 | 0.128 | 0.816 | ||
| S016 | 0.021 | 0.605 | 0.128 | 0.678 | ||
| S061 | 0.021 | 0.593 | 0.126 | 1.281 | ||
| S055 | 0.057 | 0.553 | 0.125 | 0.756 | ||
| S031 | 0.016 | 0.669 | 0.125 | 0.780 | ||
| S005 | 0.000 | 0.999 | 0.125 | 0.877 | ||
| S010 | 0.068 | 1.439 | 0.122 | 1.152 | 0.968 | 0.159 |
| S099 | 0.016 | 0.696 | 0.122 | 0.691 | ||
| S027 | 0.010 | 0.706 | 0.122 | 0.730 | ||
| S028 | 0.052 | 0.775 | 0.117 | 0.887 | ||
| S056 | 0.052 | 0.568 | 0.115 | 0.664 | ||
| S069 | 0.010 | 0.859 | 0.107 | 0.893 | ||
| S078 | 0.000 | 1.016 | 0.104 | 1.021 | ||
| S090 | 0.026 | 0.610 | 0.096 | 0.809 | ||
| S049 | 0.042 | 0.990 | 0.096 | 0.968 | ||
| S029 | 0.068 | 0.875 | 0.094 | 0.924 | ||
| S012 | 0.016 | 0.699 | 0.094 | 0.928 |
p <- data |>
filter((as.numeric(gsub("\\D", "", Participant)) <= 11) | (as.numeric(gsub("\\D", "", Participant)) >= 61)) |>
estimate_density(select = "RT", at = c("Participant", "Task", "Block")) |>
group_by(Participant) |>
normalize(select = "y") |>
ungroup() |>
mutate(
# Participant = fct_relevel(Participant, as.character(table$Participant)),
color = case_when(
Participant %in% outliers_perceptual & Task == "Perceptual" ~ "red",
Participant %in% outliers_illusion1 & Task == "Illusion_Session1" ~ "red",
Participant %in% outliers_illusion2 & Task == "Illusion_Session2" ~ "red",
TRUE ~ "blue"
),
Task = fct_recode(Task,
"Illusion task (session 1)" = "Illusion_Session1",
"Illusion task (session 2)" = "Illusion_Session2",
"Perceptual task" = "Perceptual"
)
) |>
ggplot(aes(x = x, y = y)) +
geom_area(data = normalize(estimate_density(data, select = "RT"), select = "y"), alpha = 0.2) +
geom_line(aes(color = color, group = interaction(Participant, Block), linetype = Block), size = 0.5) +
geom_vline(xintercept = 0.125, linetype = "dashed", color = "red", size = 0.5) +
scale_color_manual(values = c("red" = "#F44336", "orange" = "#FF9800", "blue" = "blue"), guide = "none") +
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0)) +
coord_cartesian(xlim = c(0, 2)) +
theme_modern() +
theme(axis.text.y = element_blank()) +
facet_grid(Participant ~ Task) +
labs(y = "", x = "Reaction Time (s)")
# p
ggsave("figures/outliers_RT.png", p, width = 8, height = 24, dpi = 100)
knitr::include_graphics("figures/outliers_RT.png")
illusion1 <- filter(illusion1, !Participant %in% outliers_illusion1)
illusion2 <- filter(illusion2, !Participant %in% outliers_illusion2)
perceptual <- filter(perceptual, !Participant %in% outliers_perceptual)
For each block, we computed the error rate and, if more than 50%, we discarded the whole block (as it likely indicates that instructions got mixed up, for instance participants were selecting the smaller instead of the bigger circle).
data <- rbind(illusion1, illusion2, perceptual) |>
group_by(Participant, Task, Illusion_Type, Block) |>
summarize(ErrorRate_per_block = sum(Error) / n()) |>
ungroup() |>
arrange(desc(ErrorRate_per_block))
data |>
estimate_density(at = c("Task", "Illusion_Type", "Block"), method = "KernSmooth") |>
ggplot(aes(x = x, y = y)) +
geom_line(aes(color = Illusion_Type, linetype = Block)) +
geom_vline(xintercept = 0.5, linetype = "dashed") +
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0)) +
scale_color_manual(values = c("Ebbinghaus" = "#2196F3", "MullerLyer" = "#4CAF50", "VerticalHorizontal" = "#FF5722")) +
labs(y = "Distribution", x = "Error Rate") +
theme_modern() +
facet_wrap(~Task)
remove_badblocks <- function(df) {
n <- nrow(df)
df <- df |>
group_by(Participant, Illusion_Type, Block) |>
mutate(ErrorRate_per_block = sum(Error) / n()) |>
ungroup() |>
filter(ErrorRate_per_block < 0.5) |>
select(-ErrorRate_per_block)
text <- paste0(
"We removed ",
n - nrow(df),
" (",
insight::format_value((n - nrow(df)) / n, as_percent = TRUE),
") trials belonging to bad blocks."
)
list(data = df, text = text)
}
out <- remove_badblocks(illusion1)
print(paste("Illusion (session 1):", out$text))
[1] “Illusion (session 1): We removed 128 (0.33%) trials belonging to bad blocks.”
illusion1 <- out$data
out <- remove_badblocks(illusion2)
print(paste("Illusion (session 2):", out$text))
[1] “Illusion (session 2): We removed 64 (4.17%) trials belonging to bad blocks.”
illusion2 <- out$data
out <- remove_badblocks(perceptual)
print(paste("Perceptual task:", out$text))
[1] “Perceptual task: We removed 96 (0.51%) trials belonging to bad blocks.”
perceptual <- out$data
check_trials <- function(df) {
data <- df |>
mutate(Outlier = ifelse(RT >= 10, TRUE, FALSE)) |>
group_by(Participant) |>
mutate(Outlier = ifelse(RT < 0.125 | standardize(RT, robust = TRUE) > 4, TRUE, Outlier)) |>
ungroup()
p1 <- data |>
filter(RT < 10) |>
estimate_density(select = "RT", at = "Participant") |>
group_by(Participant) |>
normalize(select = "y") |>
ungroup() |>
merge(data |>
group_by(Participant) |>
mutate(Threshold = median(RT) + 4 * mad(RT)) |>
filter(Error == 0) |>
summarize(Threshold = mean(Threshold))) |>
mutate(Outlier = ifelse(x >= Threshold, TRUE, FALSE)) |>
ggplot(aes(x = x, y = y)) +
geom_area(data = normalize(estimate_density(filter(data, RT < 10), select = "RT"), select = "y"), alpha = 0.2) +
geom_line(aes(color = Participant, linetype = Outlier), alpha = 0.2) +
geom_vline(xintercept = c(125), linetype = "dashed", color = "red") +
scale_color_material_d("rainbow", guide = "none") +
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0)) +
guides(linetype = "none") +
coord_cartesian(xlim = c(0, 5)) +
theme_modern() +
theme(axis.text.y = element_blank()) +
labs(y = "", x = "Reaction Time (s)")
p2 <- data |>
group_by(Participant) |>
summarize(Outlier = sum(Outlier) / nrow(illusion1)) |>
mutate(Participant = fct_reorder(Participant, Outlier)) |>
ggplot(aes(x = Participant, y = Outlier)) +
geom_bar(stat = "identity", aes(fill = Participant)) +
scale_fill_material_d("rainbow", guide = "none") +
scale_x_discrete(expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0), labels = scales::percent) +
see::theme_modern() +
theme(axis.text.x = element_blank()) +
labs(y = "Percentage of outlier trials")
text <- paste0(
"We removed ",
sum(data$Outlier),
" (",
insight::format_value(sum(data$Outlier) / nrow(data), as_percent = TRUE),
") outlier trials (125 ms < RT < 4 MAD above median)."
)
data <- filter(data, Outlier == FALSE)
data$Outlier <- NULL
list(p = p1 / p2, data = data, text = text)
}
out <- check_trials(illusion1)
print(paste("Illusion (session 1):", out$text))
[1] “Illusion (session 1): We removed 1335 (3.49%) outlier trials (125 ms < RT < 4 MAD above median).”
out$p
illusion1 <- out$data
out <- check_trials(illusion2)
print(paste("Illusion (session 2):", out$text))
[1] “Illusion (session 2): We removed 49 (3.33%) outlier trials (125 ms < RT < 4 MAD above median).”
out$p
illusion2 <- out$data
out <- check_trials(perceptual)
print(paste("Perceptual task:", out$text))
[1] “Perceptual task: We removed 853 (4.51%) outlier trials (125 ms < RT < 4 MAD above median).”
out$p
perceptual <- out$data
We compute a multivariate outlier score.
outliers <- sub |>
select(AttentionCheck_Session1,
IPIP6_RT, PID5_RT, GCBS_RT, ASQ_RT, LIE_RT, SPQ_RT,
IPIP6_SD, PID5_SD, PHQ4_SD) |>
standardize() |>
performance::check_outliers(method = c("mahalanobis", "mahalanobis_robust", "mcd", "ics"))
sub$Potential_Outliers <- as.data.frame(outliers)$Outlier
outliers
## 9 outliers detected: cases 7, 42, 45, 49, 51, 78, 85, 91, 95.
## - Based on the following methods and thresholds: mahalanobis (29.59),
## mahalanobis_robust (29.59), mcd (29.59), ics (0).
## - For variables: AttentionCheck_Session1, IPIP6_RT, PID5_RT, GCBS_RT,
## ASQ_RT, LIE_RT, SPQ_RT, IPIP6_SD, PID5_SD, PHQ4_SD.
##
## Note: Outliers were classified as such by at least half of the selected methods.
##
## -----------------------------------------------------------------------------
## The following observations were considered outliers for two or more variables
## by at least one of the selected methods:
##
## Row n_Mahalanobis n_Mahalanobis_robust n_MCD n_ICS
## 1 7 (Multivariate) (Multivariate) (Multivariate) (Multivariate)
## 2 42 (Multivariate) (Multivariate) (Multivariate) (Multivariate)
## 3 49 (Multivariate) (Multivariate) (Multivariate) (Multivariate)
## 4 51 (Multivariate) (Multivariate) (Multivariate) (Multivariate)
## 5 78 (Multivariate) (Multivariate) (Multivariate) (Multivariate)
## 6 85 (Multivariate) (Multivariate) (Multivariate) (Multivariate)
## 7 91 (Multivariate) (Multivariate) (Multivariate) (Multivariate)
## 8 95 (Multivariate) (Multivariate) (Multivariate) 0
## 9 11 0 (Multivariate) (Multivariate) 0
## 10 15 0 (Multivariate) 0 0
## 11 23 0 (Multivariate) 0 0
## 12 28 0 (Multivariate) (Multivariate) 0
## 13 29 0 (Multivariate) (Multivariate) 0
## 14 30 0 (Multivariate) (Multivariate) 0
## 15 32 0 (Multivariate) (Multivariate) 0
## 16 45 0 (Multivariate) (Multivariate) (Multivariate)
## 17 52 0 (Multivariate) (Multivariate) 0
## 18 57 0 (Multivariate) (Multivariate) 0
## 19 58 0 (Multivariate) 0 0
## 20 59 0 (Multivariate) (Multivariate) 0
## 21 60 0 (Multivariate) 0 0
## 22 68 0 (Multivariate) (Multivariate) 0
## 23 69 0 (Multivariate) (Multivariate) 0
## 24 80 0 (Multivariate) (Multivariate) 0
## 25 83 0 (Multivariate) (Multivariate) 0
## 26 88 0 (Multivariate) (Multivariate) 0
## 27 89 0 (Multivariate) (Multivariate) 0
## 28 92 0 (Multivariate) (Multivariate) 0
## 29 93 0 (Multivariate) (Multivariate) 0
outliers_questionnaires <- c(
"S003", "S008", "S068"
)
We removed the questionnaire data from 3 participants upon inspection of attention checks and time taken to complete each questionnaires.
table <- sub |>
mutate(
Outlier_Task1 = Participant %in% outliers_illusion1,
Outlier_Task2 = Participant %in% outliers_illusion2,
Outlier_Task3 = Participant %in% outliers_perceptual,
Outlier_Tasks = Outlier_Task1 + Outlier_Task2 + Outlier_Task3
) |>
select(
Participant,
Outlier_Tasks,
Potential_Outliers,
AttentionCheck_Session1,
IPIP6_RT, PID5_RT, ASQ_RT, SPQ_RT,
IPIP6_SD, PID5_SD, PHQ4_SD,
AttentionCheck_Session2,
BPD_RT, MAIA_RT, PI_RT,
BPD_SD, MAIA_SD, PI_SD
) |>
# mutate(across(ends_with("IPIP6_RT") | ends_with("IPIP6_SD"), standardize)) |>
# arrange(desc(Outlier_Tasks), AttentionCheck_Session1)
arrange(desc(Participant))
t <- data.frame(Participant = c("Average"), t(sapply(table[2:ncol(table)], mean, na.rm = TRUE))) |>
rbind(table) |>
knitr::kable() |>
kableExtra::row_spec(1, italic = TRUE) |>
kableExtra::row_spec(which(table$Participant %in% outliers_questionnaires) + 1, background = "#EF9A9A")
for (i in 2:ncol(table)) {
t <- kableExtra::column_spec(
t, i,
color = "white",
background = kableExtra::spec_color(
c(NA, table[[i]]),
option = "D",
alpha = 1,
# direction = ifelse(str_detect(names(table)[i], "_SD|Outlier"), 1, -1),
na_color = "white",
)
)
}
t |>
kableExtra::row_spec(1, background = "grey") |>
kableExtra::kable_styling(full_width = TRUE, font_size = 9) |>
kableExtra::scroll_box(width = "100%", height = "500px")
| Participant | Outlier_Tasks | Potential_Outliers | AttentionCheck_Session1 | IPIP6_RT | PID5_RT | ASQ_RT | SPQ_RT | IPIP6_SD | PID5_SD | PHQ4_SD | AttentionCheck_Session2 | BPD_RT | MAIA_RT | PI_RT | BPD_SD | MAIA_SD | PI_SD |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Average | 0.04 | 0.173 | 0.959 | 1.889 | 2.591 | 2.503 | 3.22 | 0.200 | 0.670 | 0.406 | 0.656 | 1.052 | 2.99 | 3.55 | 0.241 | 0.129 | 0.701 |
| S101 | 0.00 | 0.000 | 1.000 | 1.567 | 1.772 | 2.167 | 2.59 | 0.189 | 0.309 | 0.354 | |||||||
| S100 | 0.00 | 0.000 | 1.000 | 1.696 | 2.091 | 1.793 | 2.91 | 0.141 | 0.577 | 0.000 | |||||||
| S099 | 0.00 | 1.000 | 0.886 | 2.410 | 2.758 | 2.462 | 5.87 | 0.391 | 0.724 | 0.000 | |||||||
| S098 | 0.00 | 0.000 | 1.000 | 1.644 | 1.681 | 1.968 | 3.40 | 0.207 | 0.957 | 0.707 | |||||||
| S097 | 0.00 | 0.000 | 1.000 | 1.009 | 1.301 | 1.626 | 1.79 | 0.118 | 0.410 | 0.354 | |||||||
| S096 | 0.00 | 0.250 | 1.000 | 1.673 | 1.483 | 1.753 | 2.44 | 0.350 | 0.924 | 1.414 | |||||||
| S095 | 0.00 | 0.000 | 1.000 | 1.345 | 1.592 | 1.836 | 1.82 | 0.150 | 0.774 | 0.707 | |||||||
| S094 | 0.00 | 0.000 | 0.964 | 1.700 | 2.307 | 2.572 | 4.05 | 0.185 | 0.855 | 0.000 | |||||||
| S093 | 0.00 | 0.000 | 1.000 | 1.897 | 2.166 | 2.882 | 3.54 | 0.135 | 0.724 | 0.000 | |||||||
| S092 | 0.00 | 0.000 | 1.000 | 1.178 | 2.504 | 2.125 | 2.87 | 0.200 | 0.814 | 0.354 | |||||||
| S091 | 0.00 | 0.000 | 0.893 | 0.852 | 1.412 | 1.357 | 2.73 | 0.090 | 0.707 | 0.707 | |||||||
| S090 | 0.00 | 0.000 | 1.000 | 1.984 | 2.113 | 2.294 | 3.32 | 0.246 | 0.618 | 0.354 | |||||||
| S089 | 0.00 | 1.000 | 0.891 | 6.854 | 2.193 | 2.354 | 2.85 | 0.201 | 0.545 | 0.354 | |||||||
| S088 | 0.00 | 0.000 | 1.000 | 2.068 | 2.503 | 3.000 | 4.07 | 0.237 | 0.410 | 0.000 | |||||||
| S087 | 0.00 | 0.000 | 1.000 | 1.566 | 4.313 | 2.873 | 2.85 | 0.196 | 0.652 | 0.707 | |||||||
| S086 | 0.00 | 0.000 | 0.924 | 2.013 | 2.597 | 2.479 | 3.68 | 0.292 | 0.834 | 0.000 | |||||||
| S085 | 0.00 | 0.000 | 0.880 | 1.307 | 3.385 | 2.514 | 2.84 | 0.164 | 0.756 | 0.354 | |||||||
| S084 | 0.00 | 0.000 | 1.000 | 1.795 | 1.887 | 2.720 | 3.04 | 0.206 | 0.797 | 0.354 | |||||||
| S083 | 0.00 | 0.500 | 1.000 | 2.247 | 4.753 | 4.815 | 5.16 | 0.214 | 0.110 | 0.354 | |||||||
| S082 | 0.00 | 0.000 | 0.999 | 0.789 | 1.058 | 1.190 | 1.35 | 0.291 | 1.384 | 0.354 | |||||||
| S081 | 0.00 | 0.000 | 0.964 | 1.177 | 2.558 | 2.437 | 2.48 | 0.166 | 0.825 | 0.707 | |||||||
| S080 | 0.00 | 0.500 | 1.000 | 1.130 | 3.723 | 2.102 | 3.19 | 0.426 | 0.817 | 1.061 | |||||||
| S079 | 0.00 | 0.500 | 1.000 | 1.320 | 2.051 | 2.116 | 4.95 | 0.253 | 0.836 | 0.000 | |||||||
| S078 | 0.00 | 0.000 | 1.000 | 1.120 | 1.865 | 1.645 | 2.06 | 0.170 | 0.418 | 0.354 | |||||||
| S077 | 0.00 | 0.000 | 1.000 | 1.327 | 1.885 | 1.707 | 2.35 | 0.360 | 0.862 | 0.354 | |||||||
| S076 | 0.00 | 0.000 | 0.964 | 1.597 | 2.249 | 2.194 | 2.50 | 0.153 | 0.675 | 0.707 | |||||||
| S075 | 0.00 | 0.000 | 1.000 | 1.848 | 3.184 | 3.326 | 4.55 | 0.218 | 0.858 | 0.354 | |||||||
| S074 | 0.00 | 0.000 | 0.929 | 1.309 | 1.640 | 1.664 | 1.86 | 0.186 | 0.713 | 0.707 | |||||||
| S073 | 0.00 | 0.000 | 0.964 | 1.626 | 1.868 | 1.930 | 2.48 | 0.190 | 0.666 | 0.000 | |||||||
| S072 | 0.00 | 1.000 | 1.000 | 1.283 | 14.469 | 2.321 | 2.31 | 0.175 | 0.559 | 0.707 | |||||||
| S071 | 0.00 | 0.000 | 1.000 | 1.652 | 2.506 | 2.479 | 2.67 | 0.185 | 0.834 | 0.354 | |||||||
| S070 | 0.00 | 0.250 | 0.788 | 1.907 | 2.070 | 2.267 | 2.46 | 0.169 | 0.643 | 0.000 | |||||||
| S069 | 0.00 | 0.500 | 0.952 | 3.627 | 1.232 | 1.318 | 6.02 | 0.192 | 0.509 | 0.707 | |||||||
| S068 | 0.00 | 0.500 | 0.621 | 1.335 | 1.479 | 2.720 | 3.73 | 0.163 | 0.320 | 0.354 | |||||||
| S067 | 0.00 | 0.000 | 0.910 | 1.005 | 1.141 | 1.345 | 1.46 | 0.186 | 0.545 | 0.707 | |||||||
| S066 | 0.00 | 1.000 | 1.000 | 2.697 | 3.905 | 6.625 | 5.19 | 0.437 | 0.868 | 1.061 | |||||||
| S065 | 0.00 | 0.000 | 0.964 | 1.282 | 1.868 | 2.154 | 2.85 | 0.226 | 0.675 | 0.000 | |||||||
| S064 | 0.00 | 0.000 | 1.000 | 2.103 | 3.373 | 2.784 | 4.02 | 0.079 | 0.823 | 0.354 | |||||||
| S063 | 0.00 | 0.000 | 0.891 | 1.521 | 1.713 | 2.049 | 2.05 | 0.188 | 0.676 | 0.354 | |||||||
| S062 | 0.00 | 0.000 | 1.000 | 1.922 | 2.015 | 2.030 | 2.41 | 0.084 | 0.534 | 0.354 | |||||||
| S061 | 0.00 | 0.500 | 1.000 | 0.817 | 6.877 | 1.362 | 1.87 | 0.145 | 0.509 | 0.000 | |||||||
| S060 | 0.00 | 0.000 | 0.964 | 1.567 | 2.094 | 2.395 | 3.00 | 0.210 | 0.509 | 0.354 | |||||||
| S059 | 0.00 | 0.000 | 0.997 | 2.304 | 2.234 | 2.914 | 2.42 | 0.255 | 0.907 | 0.707 | |||||||
| S058 | 0.00 | 0.000 | 1.000 | 2.149 | 3.804 | 2.734 | 4.26 | 0.209 | 0.647 | 1.414 | |||||||
| S057 | 0.00 | 0.000 | 1.000 | 3.019 | 2.526 | 2.324 | 3.80 | 0.167 | 0.724 | 0.354 | |||||||
| S056 | 0.00 | 0.000 | 1.000 | 1.477 | 1.661 | 2.534 | 2.42 | 0.181 | 0.577 | 1.061 | |||||||
| S055 | 0.00 | 0.000 | 0.964 | 1.084 | 1.428 | 1.200 | 1.91 | 0.237 | 0.715 | 0.000 | |||||||
| S054 | 0.00 | 0.000 | 0.857 | 2.392 | 3.006 | 2.951 | 3.40 | 0.158 | 0.597 | 0.707 | |||||||
| S053 | 0.00 | 0.000 | 1.000 | 1.324 | 2.183 | 1.636 | 2.44 | 0.117 | 0.571 | 0.000 | |||||||
| S052 | 0.00 | 0.000 | 1.000 | 1.873 | 2.227 | 2.108 | 2.54 | 0.140 | 0.537 | 0.354 | |||||||
| S051 | 0.00 | 0.000 | 1.000 | 2.072 | 2.736 | 2.599 | 3.64 | 0.157 | 0.199 | 0.354 | |||||||
| S050 | 0.00 | 0.000 | 1.000 | 1.454 | 2.037 | 2.662 | 2.68 | 0.216 | 0.460 | 0.000 | |||||||
| S049 | 0.00 | 0.500 | 0.929 | 2.178 | 4.859 | 3.562 | 5.11 | 0.207 | 0.528 | 0.000 | |||||||
| S048 | 0.00 | 0.000 | 1.000 | 1.377 | 1.914 | 2.253 | 2.99 | 0.196 | 0.537 | 0.354 | |||||||
| S047 | 0.00 | 0.500 | 0.779 | 4.321 | 1.188 | 0.905 | 3.75 | 0.184 | 0.089 | 0.000 | |||||||
| S046 | 0.00 | 0.000 | 1.000 | 1.099 | 1.136 | 1.422 | 1.60 | 0.100 | 0.666 | 0.707 | |||||||
| S045 | 0.00 | 0.000 | 0.893 | 2.371 | 2.143 | 2.942 | 3.05 | 0.258 | 0.606 | 0.354 | |||||||
| S044 | 0.00 | 0.000 | 0.964 | 1.625 | 2.098 | 2.295 | 3.22 | 0.170 | 0.699 | 0.354 | |||||||
| S043 | 0.00 | 0.000 | 0.964 | 1.304 | 1.868 | 1.949 | 2.29 | 0.219 | 0.398 | 0.354 | |||||||
| S042 | 0.00 | 0.000 | 1.000 | 1.204 | 1.659 | 1.917 | 2.41 | 0.160 | 0.545 | 1.061 | |||||||
| S041 | 0.00 | 0.000 | 1.000 | 1.455 | 1.949 | 1.693 | 2.06 | 0.181 | 0.732 | 0.354 | |||||||
| S040 | 0.00 | 0.000 | 1.000 | 1.422 | 1.965 | 1.220 | 1.95 | 0.121 | 0.687 | 0.707 | |||||||
| S039 | 0.00 | 0.000 | 1.000 | 2.092 | 3.134 | 2.945 | 2.90 | 0.190 | 0.656 | 0.707 | |||||||
| S038 | 0.00 | 0.500 | 0.964 | 3.351 | 6.988 | 3.231 | 6.15 | 0.196 | 0.687 | 0.354 | |||||||
| S037 | 0.00 | 0.500 | 1.000 | 0.770 | 4.167 | 2.955 | 1.45 | 0.104 | 0.398 | 0.354 | |||||||
| S036 | 0.00 | 0.000 | 0.996 | 1.325 | 1.921 | 1.766 | 2.58 | 0.226 | 0.728 | 0.354 | |||||||
| S035 | 0.00 | 0.000 | 0.993 | 2.358 | 2.258 | 2.601 | 2.81 | 0.182 | 0.837 | 0.354 | |||||||
| S034 | 0.00 | 0.000 | 1.000 | 2.966 | 3.338 | 4.372 | 5.71 | 0.182 | 0.617 | 0.354 | |||||||
| S033 | 0.00 | 0.000 | 1.000 | 0.692 | 0.890 | 1.091 | 1.23 | 0.088 | 0.288 | 0.000 | |||||||
| S032 | 0.00 | 0.000 | 1.000 | 1.131 | 1.565 | 2.121 | 2.21 | 0.148 | 0.736 | 0.000 | |||||||
| S031 | 0.00 | 0.000 | 0.964 | 1.509 | 1.611 | 1.729 | 1.97 | 0.224 | 0.830 | 0.354 | |||||||
| S030 | 0.00 | 0.500 | 0.776 | 3.296 | 2.679 | 4.596 | 4.46 | 0.222 | 0.948 | 0.000 | |||||||
| S029 | 0.00 | 0.750 | 0.913 | 1.302 | 6.534 | 3.338 | 3.83 | 0.167 | 1.146 | 0.000 | |||||||
| S028 | 0.00 | 0.000 | 0.964 | 1.741 | 3.268 | 2.695 | 3.60 | 0.172 | 0.585 | 0.707 | |||||||
| S027 | 0.00 | 0.000 | 1.000 | 1.369 | 1.777 | 2.340 | 4.06 | 0.161 | 0.675 | 0.000 | |||||||
| S026 | 0.00 | 0.500 | 1.000 | 4.696 | 5.658 | 5.382 | 6.23 | 0.173 | 0.790 | 0.354 | |||||||
| S025 | 0.00 | 0.500 | 1.000 | 2.561 | 2.680 | 5.594 | 4.80 | 0.317 | 0.748 | 0.000 | |||||||
| S024 | 0.00 | 0.000 | 1.000 | 2.115 | 3.116 | 3.465 | 3.90 | 0.182 | 0.835 | 1.414 | |||||||
| S023 | 0.00 | 0.000 | 1.000 | 1.548 | 1.875 | 2.191 | 2.89 | 0.277 | 0.674 | 0.000 | |||||||
| S022 | 0.00 | 0.000 | 1.000 | 1.121 | 1.435 | 1.802 | 2.78 | 0.217 | 0.610 | 0.000 | |||||||
| S021 | 0.00 | 1.000 | 1.000 | 4.232 | 3.404 | 6.555 | 7.42 | 0.484 | 0.819 | 1.061 | |||||||
| S020 | 0.00 | 0.250 | 0.860 | 1.631 | 2.575 | 2.375 | 3.25 | 0.256 | 1.017 | 1.414 | |||||||
| S019 | 0.00 | 0.250 | 0.893 | 1.980 | 2.789 | 3.059 | 5.71 | 0.205 | 0.744 | 0.354 | |||||||
| S018 | 0.00 | 0.000 | 1.000 | 1.658 | 2.039 | 2.027 | 2.61 | 0.146 | 0.656 | 1.061 | |||||||
| S017 | 0.00 | 0.000 | 0.964 | 1.299 | 1.681 | 1.911 | 2.06 | 0.201 | 0.937 | 0.354 | |||||||
| S016 | 0.00 | 0.500 | 0.964 | 4.064 | 5.145 | 3.684 | 5.76 | 0.076 | 0.551 | 0.354 | |||||||
| S015 | 0.00 | 0.000 | 1.000 | 1.045 | 1.275 | 1.418 | 2.60 | 0.292 | 0.713 | 0.354 | |||||||
| S014 | 0.00 | 0.000 | 1.000 | 0.818 | 1.350 | 1.324 | 1.52 | 0.225 | 0.467 | 0.354 | |||||||
| S013 | 0.00 | 0.000 | 1.000 | 1.071 | 1.270 | 1.418 | 2.42 | 0.093 | 0.710 | 0.000 | |||||||
| S012 | 0.00 | 0.500 | 0.821 | 3.183 | 5.186 | 5.265 | 5.37 | 0.193 | 0.577 | 0.354 | |||||||
| S011 | 0.00 | 1.000 | 1.000 | 1.871 | 2.802 | 2.380 | 3.38 | 0.155 | 0.814 | 0.354 | 0.667 | 1.188 | 3.28 | 3.53 | 0.313 | 0.130 | 0.769 |
| S010 | 0.00 | 0.000 | 0.964 | 1.848 | 2.864 | 2.614 | 3.65 | 0.263 | 1.243 | 0.000 | 0.667 | 1.624 | 4.46 | 5.13 | 0.307 | 0.138 | 0.737 |
| S009 | 0.00 | 0.000 | 1.000 | 1.347 | 2.064 | 2.250 | 2.51 | 0.296 | 0.635 | 0.354 | |||||||
| S008 | 2.00 | 0.500 | 0.762 | 3.125 | 0.986 | 1.307 | 1.29 | 0.024 | 0.000 | 0.000 | |||||||
| S007 | 0.00 | 0.000 | 0.929 | 1.095 | 1.324 | 1.792 | 2.00 | 0.211 | 0.702 | 0.707 | |||||||
| S006 | 0.00 | 0.000 | 1.000 | 1.950 | 2.418 | 2.383 | 3.76 | 0.290 | 0.960 | 0.354 | 0.667 | 0.930 | 3.35 | 3.41 | 0.324 | 0.131 | 0.556 |
| S005 | 0.00 | 0.000 | 1.000 | 1.828 | 2.952 | 2.998 | 3.55 | 0.163 | 0.577 | 0.707 | |||||||
| S004 | 0.00 | 0.750 | 0.893 | 5.980 | 2.109 | 2.576 | 3.29 | 0.187 | 0.713 | 0.354 | |||||||
| S003 | 2.00 | 0.000 | 0.857 | 0.955 | 1.375 | 2.160 | 1.96 | 0.216 | 0.847 | 0.000 | 0.613 | 0.719 | 1.59 | 3.71 | 0.102 | 0.098 | 0.819 |
| S002 | 0.00 | 0.000 | 0.917 | 1.690 | 2.410 | 2.997 | 2.71 | 0.254 | 0.571 | 0.354 | 0.667 | 0.798 | 2.27 | 1.96 | 0.159 | 0.146 | 0.624 |
| S001 | 0.00 | 1.000 | 0.728 | 1.912 | 2.523 | 4.542 | 7.27 | 0.179 | 0.659 | 0.707 |
# Inspection: select(sub[sub$Participant == "S008", ], starts_with("Item_PID"))
sub[
sub$Participant %in% outliers_questionnaires,
names(sub)[!names(sub) %in% c(
"Participant", "Nationality", "Age",
"Ethnicity", "Sex", "Student", "Education",
"Interval", "AttentionCheck_Session1",
"AttentionCheck_Session2"
)]
] <- NA
We collected data from 101 participants.
illusion1 <- illusion1[!illusion1$Participant %in% outliers_illusion1, ]
illusion2 <- illusion2[!illusion2$Participant %in% outliers_illusion1, ]
perceptual <- perceptual[!perceptual$Participant %in% outliers_illusion1, ]
sub <- sub[!sub$Participant %in% outliers_illusion1, ]
The final sample included 100 participants (Mean age = 29.0, SD = 8.3, range: [20, 54]; Sex: 49.0% females, 51.0% males, 0.0% other; Education: High school, 30.00%; Bachelor, 53.00%; Master, 16.00%; Doctorate, 1.00%; Other, 0.00%), from which 2 (2.00%) completed session 2.
select(sub, region = Nationality) |>
group_by(region) |>
summarize(n = n()) |>
right_join(map_data("world"), by = "region") |>
ggplot(aes(long, lat, group = group)) +
geom_polygon(aes(fill = n)) +
scale_fill_gradientn(colors = c("#FFEB3B", "red")) +
theme_void() +
ggtitle("Number of participants by country of origin")
estimate_density(sub$Age) |>
normalize(select = y) |>
ggplot(aes(x = x, y = y)) +
geom_area(fill = "#607D8B") +
geom_vline(xintercept = mean(sub$Age), color = "red") +
geom_label(data = data.frame(x = mean(sub$Age) * 1.1, y = 0.95), color = "red", label = paste0("Mean = ", format_value(mean(sub$Age)))) +
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0)) +
labs(title = "Age", y = "Distribution", color = NULL) +
theme_modern(axis.title.space = 10) +
theme(
plot.title = element_text(size = rel(1), face = "bold", hjust = 0.5),
plot.subtitle = element_text(face = "italic", hjust = 0.5),
axis.text.y = element_blank(),
axis.text.x = element_text(size = rel(0.8)),
axis.title.x = element_blank()
)
plot_waffle <- function(sub, what = "Nationality", title = what, rows = 8, size = 3) {
ggwaffle::waffle_iron(sub, what, rows = rows) |>
ggplot(aes(x, y)) +
geom_point(aes(color = group), shape = "square", size = size) +
coord_equal() +
ggtitle(title) +
labs(fill = "", color = "") +
theme_void() +
theme(
plot.title = element_text(face = "bold", hjust = 0.5),
legend.key.height = unit(1, "mm"),
legend.key.width = unit(1, "mm")
)
}
plot_waffle(sub, "Ethnicity", rows = 10, size = 5) +
scale_color_manual(values = c("Hispanic" = "#FF5722", "Caucasian" = "#2196F3", "African" = "#4CAF50", "Asian" = "#FFC107", "Other" = "#795548"))
sub |>
ggplot(aes(x = Education)) +
geom_bar(aes(fill = Education)) +
scale_y_continuous(expand = c(0, 0), breaks= scales::pretty_breaks()) +
scale_fill_viridis_d(guide = "none") +
labs(title = "Education", y = "Number of Participants") +
theme_modern(axis.title.space = 15) +
theme(
plot.title = element_text(size = rel(1), face = "bold", hjust = 0.5),
plot.subtitle = element_text(face = "italic", hjust = 0.5),
axis.text.y = element_text(size = rel(0.8)),
axis.text.x = element_text(size = rel(0.8)),
axis.title.x = element_blank()
)
write.csv(illusion1, "../data/preprocessed_illusion1.csv", row.names = FALSE)
write.csv(illusion2, "../data/preprocessed_illusion2.csv", row.names = FALSE)
write.csv(perceptual, "../data/preprocessed_perceptual.csv", row.names = FALSE)
write.csv(sub, "../data/preprocessed_questionnaires.csv", row.names = FALSE)